home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Almathera Ten Pack 3: CDPD 3
/
Almathera Ten on Ten - Disc 3: CDPD3.iso
/
scope
/
051-075
/
scopedisk62
/
quicklib
/
quicklib.bas
< prev
next >
Wrap
BASIC Source File
|
1995-03-19
|
5KB
|
227 lines
'* * * * * * * * * * * * * *
'* *
'* QUICK_LIB *
'* *
'* *
'* Source code *
'* by *
'* Robert D'Asto *
'* *
'* * * * * * * * * * * * * *
'************************************
'*
'* copyright 1988 PiM Publications
'*
'* this program appeared in the March '89
'* issue of Amazing Computing [PO Box 869,
'* Fall River, MA 02722, 508-678-4200]
'* reproduced and distributed with
'* permission
'*
'* Typed in and somewhat tweaked up by
'* Bernie Cosell (cosell@bbn.com)
'* The version in AC worked fine, so if this
'* one doesn't, I screwed up either in my typing
'* or in my "improvements"
'*
'***************************************
ON BREAK GOSUB endit
BREAK ON
MENU 1,0,1," Quick Lib "
MENU 1,1,1," Load bmap "
MENU 1,2,1," Quit "
MENU 2,0,0," "
MENU 3,0,0," "
MENU 4,0,0," "
ON MENU GOSUB MenuSort
MENU ON
WHILE -1
SLEEP
WEND
MenuSort:
IF MENU(1) = 1 THEN GOSUB Loadbmap
IF MENU(1) = 2 THEN GOSUB endit
RETURN
Loadbmap:
bmap.name$ = ""
lib.name$ = ""
subname$ = ""
Q$ = CHR$(34)
CLS
startload:
PRINT
INPUT "Name of library to load "; b$
IF RIGHT$(b$, 5) <> ".bmap" THEN
IF RIGHT$(b$, 8) = ".library" THEN
b$ = LEFT$(b$, LEN(b$) - 8) + ".bmap"
ELSE
PRINT
PRINT "Spelling is incorrect or file"
PRINT "is misnamed. A bmap file name"
PRINT "must end with " + Q$ + ".bmap" + Q$ + "."
GOTO startload
END IF
END IF
ON ERROR GOTO CatchError
GotError = 0
OPEN b$ FOR INPUT AS 1
IF GotError THEN
GotError = 0
OPEN ":" + b$ FOR INPUT AS 1
IF GotError THEN
GotError = 0
OPEN "libs:" + b$ FOR INPUT AS 1
IF GotError THEN
ON ERROR GOTO 0
PRINT
PRINT "Can't find bmap for library " + Q$ + b$ + Q$
GOTO startload
END IF
END IF
END IF
ON ERROR GOTO 0
bmap$ = INPUT$ (LOF(1), 1)
CLOSE 1
'extract name of library from
'full pathname entered above
startpoint% = LEN(b$) - 5
namelen% = 1
control% = 100
WHILE startpoint% > 0 AND 96 < control% AND control% < 123
control% = ASC(MID$(b$, startpoint%, 1))
startpoint% = startpoint% - 1
namelen% = namelen% + 1
WEND
IF control% <= 96 OR 123 <= control% THEN
n$ = MID$(b$, startpoint%+2, namelen%-2)
ELSE
n$ = MID$(b$, startpoint%+1, namelen%-1)
END IF
'use name extracted above to
'create appropriate names for
'library, bmap and subprogram
bmap.name$ = n$ + ".bmap"
lib.name$ = n$ + ".library"
subname$ = "Init." + n$ + ".lib"
'call the GetRoutine sub, passing the
'complete bmap and above names to it
GetRoutine bmap$, lib.name$, bmap.name$, subname$
NewCycle
RETURN
endit:
MENU RESET
END
RETURN
' Little bit of machinery to allow errors to be caught easily
CatchError:
GotError = -1
RESUME NEXT
SUB GetRoutine (bmap$, lib$, bn$, s$) STATIC
CLS
Start:
routine$ = ""
fd$ = ""
Q$ = CHR$(34)
PRINT
PRINT "Name of first " + lib$ + " routine"
INPUT "you wish to use "; routine$
IF routine$ = "" THEN Start
Again:
'find routine within the bmap
offset% = INSTR(bmap$, routine$ + CHR$(0))
IF offset% = 0 THEN
PRINT "I can't find " + Q$ + routine$ + Q$ + " in this library."
PRINT "Check spelling."
PRINT
GOTO ReType
END IF
fd$ = fd$ + " fd$ = fd$ + " + Q$ + routine$ + Q$
fd$ = fd$ + " + chr$(0)" + CHR$(10) + " "
length% = LEN(routine$)+1
count% = offset% + length%
fd$ = fd$ + "fd$=fd$+"
'extract offset and parameter data
'for this routine from the bmap
char$ = ""
WHILE char$ <> CHR$(0)
char$ = MID$(bmap$, count%, 1)
fd$ = fd$ + "CHR$(" + MID$(STR$(ASC(char$)),2) + ")" + "+"
count% = count% + 1
WEND
newlength% = LEN(fd$) - 1
fd$ = LEFT$(fd$, newlength%)
fd$ = fd$ + CHR$(10)
PRINT
PRINT "Thank you. ";
ReType:
PRINT "Next routine "
INPUT "(if none press RETURN) ", routine$
IF routine$ = "" THEN
GOTO GoOn
ELSEIF routine$ = CHR$(127) THEN
GOTO Start
ELSE
GOTO Again
END IF
GoOn:
final.length% = LEN(fd$) - 1
fd$ = LEFT$(fd$, final.length%)
PRINT
INPUT "name of destination file "; destfile$
IF destfile$ = "" THEN GoOn
F$ = " for output as 1"
OPEN destfile$ FOR OUTPUT AS 1
PRINT #1, ""
PRINT #1, "SUB " + s$ + " STATIC"
PRINT #1, fd$
PRINT #1, " OPEN " + Q$ + "RAM:" + bn$ + Q$ + F$
PRINT #1, " PRINT #1, fd$;"
PRINT #1, " CLOSE 1"
PRINT #1, " LIBRARY " + Q$ + "RAM:" + lib$ + Q$
PRINT #1, "END SUB"
CLOSE 1
EXIT SUB
END SUB
SUB NewCycle STATIC
CLS
Q$ = CHR$(34)
PRINT "If you wish to use routines"
PRINT "from another library select"
PRINT Q$ + "Load bmap" + Q$ + "from menu."
EXIT SUB
END SUB